home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Whiteline: delta
/
whiteline CD Series - delta.iso
/
progtool
/
modula2
/
module
/
xbios104.mod
< prev
Wrap
Text File
|
1995-11-25
|
10KB
|
353 lines
IMPLEMENTATION MODULE XBIOS104;
(* --------------------------------------------------------------
XBIOS - Modula interface to Atari extended BIOS functions
-------------------------------------------------------------------- *)
FROM SYSTEM IMPORT BYTE, ADDRESS,VAL,ADR,REG,WORD;
FROM TRAPdefs IMPORT d0,
XBIOS0, XBIOS1w, XBIOS2w, XBIOS6w, XBIOS1l, XBIOS3l,
XBIOS1w1l, XBIOS1w2l, XBIOS3w1l, XBIOS1l1w, XBIOS2l1w,
XBIOS2l2w, XBIOS2l5w, XBIOS2l5w1l1w ;
PROCEDURE InitMouse(type: INTEGER; VAR param: ParamBlk; vec: PROC);
(* initialise mouse packet handler. *)
BEGIN
XBIOS1w2l(VAL(LONGCARD,ADR(vec)), VAL(LONGCARD,ADR(param)), type,0);
END InitMouse;
PROCEDURE ScreenPhysicalBase(): ADDRESS;
(* get the screen's physical base address at beginning of next vblank. *)
BEGIN
XBIOS0(2);
RETURN VAL(ADDRESS,REG(d0));
END ScreenPhysicalBase;
PROCEDURE ScreenLogicalBase(): ADDRESS;
(* get the screen's logical (GSX) base address. *)
BEGIN
XBIOS0(3);
RETURN VAL(ADDRESS,REG(d0));
END ScreenLogicalBase;
PROCEDURE GetResolution(): INTEGER;
(* return the screen's current resolution*)
BEGIN
XBIOS0(4);
RETURN VAL(INTEGER,REG(d0));
END GetResolution;
PROCEDURE SetScreenBase(logLoc, physLoc: ADDRESS; rez: INTEGER);
(* set screen base address and resolutions.*)
BEGIN
XBIOS2l1w(rez,VAL(LONGCARD,physLoc),VAL(LONGCARD,logLoc),5);
END SetScreenBase;
PROCEDURE SetPalette(VAR palette: Palette);
(* set the contents of the hardware palette register. *)
BEGIN
XBIOS1l(ADR(palette),6);
END SetPalette;
PROCEDURE SetColour(colourNum, colour: CARDINAL): CARDINAL;
(* set the colour of a palette table entry.*)
BEGIN
XBIOS2w(colour,colourNum,7);
RETURN VAL(CARDINAL,REG(d0))
END SetColour;
PROCEDURE FloppyRead(buf: ADDRESS; drive: CARDINAL;
sector, track, side: CARDINAL;
count: CARDINAL):INTEGER;
(* read floppy disk sector(s) into buffer.*)
BEGIN
XBIOS2l5w(count,side,track,sector,drive,0D,VAL(LONGCARD,buf),8);
RETURN VAL(INTEGER,REG(d0))
END FloppyRead;
PROCEDURE FloppyWrite(buf: ADDRESS; drive: CARDINAL;
sector, track, side: CARDINAL;
count: CARDINAL): INTEGER;
(* write buffer to floppy disk sector(s).*)
BEGIN
XBIOS2l5w(count,side,track,sector,drive,0D,VAL(LONGCARD,buf),9);
RETURN VAL(INTEGER,REG(d0))
END FloppyWrite;
PROCEDURE FloppyFormat(buf: ADDRESS; drive: CARDINAL;
spt, track, side: CARDINAL;
interleave, virgin: CARDINAL): INTEGER;
(* format a floppy disk track.*)
CONST Magic = 87654321H;
BEGIN
XBIOS2l5w1l1w(virgin,Magic,interleave,side,track,spt,drive,0D,VAL(LONGCARD,buf),10);
END FloppyFormat;
PROCEDURE MIDIWS(VAR string: ARRAY OF BYTE; len: CARDINAL);
(* write a string of characters to the MIDI port.*)
BEGIN
XBIOS1l1w(len,VAL(LONGCARD,ADR(string)),12);
END MIDIWS;
PROCEDURE MFPint(intNo: CARDINAL; vector: PROC);
(* set MFP interrupt vector.*)
BEGIN
XBIOS1w1l(VAL(LONGCARD,ADR(vector)),intNo,13);
END MFPint;
PROCEDURE IORec(dev: INTEGER): IORECPTR;
(* return pointer to serial device IO record.*)
BEGIN
XBIOS1w(dev,14);
RETURN VAL(ADDRESS, REG(d0))
END IORec;
PROCEDURE ConfigureRS232(speed,
flowctl,
ucr, rsr, tsr, scr: INTEGER);
(* configure RS232 port.*)
BEGIN
XBIOS6w(scr,tsr,rsr,ucr,flowctl,speed,15);
END ConfigureRS232;
PROCEDURE SetKeyTable(VAR unshift, shift, capslock: KeyTransPtr):
KeyTablePtr;
(* set pointers to keyboard translation tables. *)
VAR Shift,UnShift,CapsLock :LONGCARD;
BEGIN
Shift:=VAL(LONGCARD,shift);
UnShift:=VAL(LONGCARD,unshift);
CapsLock:=VAL(LONGCARD,capslock);
XBIOS3l(CapsLock,Shift,UnShift,16);
shift:=VAL(ADDRESS,Shift);
unshift:=VAL(ADDRESS,UnShift);
capslock:=VAL(ADDRESS,CapsLock);
RETURN VAL(ADDRESS,REG(d0));
END SetKeyTable;
PROCEDURE Random(): LONGCARD;
(* return a random number. *)
BEGIN
XBIOS0(17);
RETURN REG(d0);
END Random;
PROCEDURE PrototypeBootSector(buf: ADDRESS; serialNo: LONGINT;
disktype: INTEGER; execFlag: INTEGER);
(* prototype an image of a boot sector.*)
BEGIN
XBIOS2l2w(execFlag,disktype,VAL(LONGCARD,serialNo),VAL(LONGCARD,buf),18);
END PrototypeBootSector;
PROCEDURE FloppyVerify(buf: ADDRESS; drive: CARDINAL;
sector, track, side: CARDINAL;
count: CARDINAL): INTEGER;
(* verify floppy disk sectors are readable.*)
BEGIN
XBIOS2l5w(count,side,track,sector,drive,0D,VAL(LONGCARD,buf),19);
RETURN VAL(INTEGER,REG(d0));
END FloppyVerify;
PROCEDURE ScreenDump;
(* dump screen to printer. *)
BEGIN
XBIOS0(20);
END ScreenDump;
PROCEDURE ConfigureCursor(rate, attrib: INTEGER): INTEGER;
(* configure cursor blink rate and attributes,*)
BEGIN
XBIOS2w(attrib,rate,15H);
RETURN VAL(INTEGER,REG(d0))
END ConfigureCursor;
PROCEDURE SetDateTime(datetime: LONGCARD);
(* set keyboard date and time.*)
BEGIN
XBIOS1l(datetime,16H);
END SetDateTime;
PROCEDURE GetDateTime (): LONGCARD;
(* get the date and time.*)
BEGIN
XBIOS0(17H);
RETURN VAL(LONGCARD,REG(d0));
END GetDateTime;
PROCEDURE BiosKeys;
(* restore keymappings to power up settings *)
BEGIN
XBIOS0(18H);
END BiosKeys;
PROCEDURE KeyboardWS(VAR str: ARRAY OF BYTE; len: CARDINAL);
(* write string to intelligent keyboard.*)
BEGIN
XBIOS1l1w(len,VAL(LONGCARD,ADR(str)),19H)
END KeyboardWS;
PROCEDURE DisableInterrupt(intNo: CARDINAL);
(* diable given 68981 interrupt. *)
BEGIN
XBIOS1w(intNo,1AH);
END DisableInterrupt;
PROCEDURE EnableInterrupt(intNo: CARDINAL);
(* enable given 68981 interrupt. *)
BEGIN
XBIOS1w(intNo,1BH);
END EnableInterrupt;
PROCEDURE GIRead(regno: CARDINAL): CARDINAL;
(* read register on the sound chip.*)
BEGIN
XBIOS1w(regno,1CH);
RETURN VAL(CARDINAL,REG(d0));
END GIRead;
PROCEDURE GIWrite(regno, data: CARDINAL);
(* write register on the sound chip. *)
BEGIN
XBIOS2w(regno+128,data,1CH);
END GIWrite;
PROCEDURE GIOffBit(bitno: CARDINAL);
(* set a bit in the port A register to zero.*)
BEGIN
XBIOS1w(bitno,1DH);
END GIOffBit;
PROCEDURE GIOnBit(bitno: CARDINAL);
(* set a bit in the port A register to one.*)
BEGIN
XBIOS1w(bitno,1EH);
END GIOnBit;
PROCEDURE SetTimerInterrupt(timer: INTEGER; control, data: CARDINAL;
vec: PROC);
(* set an interrupt handler for timer.*)
BEGIN
XBIOS3w1l(VAL(LONGCARD,ADR(vec)),data,control,timer,1FH);
END SetTimerInterrupt;
PROCEDURE DoSound(x: ADDRESS);
(* set sound daemon's "program counter".*)
BEGIN
XBIOS1l(VAL(LONGCARD,x),20H);
END DoSound;
PROCEDURE ConfigurePrinter(config: PrtConfig): LONGCARD;
(* configure printer.*)
BEGIN
XBIOS1l(VAL(LONGCARD,ADR(config)),21H);
RETURN REG(d0);
END ConfigurePrinter;
PROCEDURE KeyboardVectors(): KBVectorPtr;
(* return pointer to keyboard vector table. *)
BEGIN
XBIOS0(22H);
RETURN VAL(ADDRESS,REG(d0));
END KeyboardVectors;
PROCEDURE KeyboardRate(initial, repeat: INTEGER): CARDINAL;
(* set keyboard repeat rate and delay.*)
(* parameter -1 liefert aktuelle Werte zurück*)
BEGIN
XBIOS2w(repeat,initial,23H);
RETURN VAL(CARDINAL,REG(d0));
END KeyboardRate;
PROCEDURE PrintBlock (parameter: ADDRESS);
BEGIN
XBIOS1l(VAL(LONGCARD,parameter),24H);
END PrintBlock;
PROCEDURE VSync;
(* wait for next vertical blank interrupt. *)
BEGIN
XBIOS0(25H);
END VSync;
PROCEDURE SuperExec(Code: PROC);
(* Run code in supervisor mode with supervisor stack.*)
BEGIN
XBIOS1l(VAL(LONGCARD,ADR(Code)),26H);
END SuperExec;
PROCEDURE PuntAES;
(* Throws away the GEM AES, freeing up memory. A re-boot will always be
performed after this call (unless AES is in ROM) *)
BEGIN
XBIOS0(27H);
END PuntAES;
(*************************** Ab TOS 1.04 **********************************)
PROCEDURE FlopRate(drive,rate:INTEGER ):LONGINT;
BEGIN
XBIOS2w(rate,drive,41);
RETURN REG(d0);
END FlopRate;
(*************************** Ab TOS 3.00 (TT-TOS) *************************)
PROCEDURE DMARead( Sector : LONGCARD; Count : CARDINAL; buffer : PROC; DeviceNo: CARDINAL);
BEGIN
(* XBIOS1l1w1l1w(42);*)
END DMARead;
PROCEDURE DMAWrite( Sector : LONGCARD; Count : CARDINAL; buffer : PROC; DeviceNo: CARDINAL);
BEGIN
(* XBIOS0(43);*)
END DMAWrite;
PROCEDURE BConMap(DeviceNo:INTEGER):ADDRESS;
BEGIN
XBIOS1w(DeviceNo,44);
RETURN VAL(ADDRESS, REG(d0));
END BConMap;
PROCEDURE SetShiftModeRegister(Mode : LONGCARD);
BEGIN
XBIOS1l(Mode,80);
END SetShiftModeRegister;
PROCEDURE GetShiftModeRegister():LONGCARD;
BEGIN
XBIOS0(81);
RETURN REG(d0);
END GetShiftModeRegister;
PROCEDURE ESetBank(RegNo,Color :INTEGER ): INTEGER;
BEGIN
XBIOS2w(Color,RegNo,82);
END ESetBank;
PROCEDURE ESetColor(RegNo,Count:CARDINAL);
BEGIN
XBIOS2w(RegNo,Count,83);
END ESetColor;
PROCEDURE EsetPalette(RegNo,Count:CARDINAL; Palette : ADDRESS);
BEGIN
(* XBIOS2w1l(Palette,RegNo,Count,84);*)
END EsetPalette;
PROCEDURE EGetPalette(RegNo,Count:CARDINAL;VAR Palette : ADDRESS);
BEGIN
(* XBIOS2w1l(Palette,RegNo,Count,85);*)
END EGetPalette;
PROCEDURE EsetGray(Color :INTEGER):BOOLEAN;
BEGIN
XBIOS1w(Color,86);
RETURN REG(d0)=1D;
END EsetGray;
PROCEDURE ESetSmear(Mode :INTEGER):BOOLEAN;
BEGIN
XBIOS1w(Mode,87);
RETURN REG(d0)=1D;
END ESetSmear;
END XBIOS104.